{2:}{$D-,W+}PROGRAM PLTOTF(PLFILE,TFMFILE);CONST{3:}BUFSIZE=60;
MAXHEADERBYT=100;MAXPARAMWORD=30;{:3}TYPE{17:}BYTE=0..255;
ASCIICODE=32..127;{:17}{57:}FOURBYTES=RECORD B0:BYTE;B1:BYTE;B2:BYTE;
B3:BYTE;END;{:57}{61:}FIXWORD=INTEGER;{:61}{68:}
HEADERINDEX=0..MAXHEADERBYT;{:68}{71:}POINTER=0..1032;{:71}VAR{5:}
PLFILE:TEXT;{:5}{15:}TFMFILE:PACKED FILE OF 0..255;{:15}{18:}
XORD:ARRAY[CHAR]OF ASCIICODE;{:18}{21:}LINE:INTEGER;GOODINDENT:INTEGER;
INDENT:INTEGER;LEVEL:INTEGER;{:21}{23:}LEFTLN,RIGHTLN:BOOLEAN;
LIMIT:0..BUFSIZE;LOC:0..BUFSIZE;BUFFER:ARRAY[1..BUFSIZE]OF CHAR;
INPUTHASENDE:BOOLEAN;{:23}{25:}CHARSONLINE:0..8;{:25}{30:}
CURCHAR:ASCIICODE;{:30}{36:}START:ARRAY[1..66]OF 0..500;
DICTIONARY:ARRAY[0..500]OF ASCIICODE;STARTPTR:0..66;DICTPTR:0..500;{:36}
{38:}CURNAME:ARRAY[1..20]OF ASCIICODE;NAMELENGTH:0..20;NAMEPTR:0..66;
{:38}{39:}HASH:ARRAY[0..100]OF 0..66;CURHASH:0..100;{:39}{44:}
EQUIV:ARRAY[0..66]OF BYTE;CURCODE:BYTE;{:44}{58:}CURBYTES:FOURBYTES;
{:58}{65:}FRACTIONDIGI:ARRAY[1..7]OF INTEGER;{:65}{67:}
HEADERBYTES:ARRAY[HEADERINDEX]OF BYTE;HEADERPTR:HEADERINDEX;
DESIGNSIZE:FIXWORD;DESIGNUNITS:FIXWORD;SEVENBITSAFE:BOOLEAN;
LIGKERN:ARRAY[0..511]OF FOURBYTES;NL:0..511;UNUSEDLABEL:BOOLEAN;
KERN:ARRAY[0..256]OF FIXWORD;NK:0..256;EXTEN:ARRAY[0..255]OF FOURBYTES;
NE:0..256;PARAM:ARRAY[1..MAXPARAMWORD]OF FIXWORD;NP:0..MAXPARAMWORD;
{:67}{72:}MEMORY:ARRAY[POINTER]OF FIXWORD;MEMPTR:POINTER;
LINK:ARRAY[POINTER]OF POINTER;CHARWD:ARRAY[BYTE]OF POINTER;
CHARHT:ARRAY[BYTE]OF POINTER;CHARDP:ARRAY[BYTE]OF POINTER;
CHARIC:ARRAY[BYTE]OF POINTER;CHARTAG:ARRAY[BYTE]OF 0..3;
CHARREMAINDE:ARRAY[BYTE]OF 0..255;{:72}{76:}NEXTD:FIXWORD;{:76}{79:}
INDEX:ARRAY[POINTER]OF BYTE;{:79}{81:}C:BYTE;{:81}{99:}KRNPTR:0..256;
{:99}{108:}SEVENUNSAFE:BOOLEAN;{:108}{112:}LIGPTR:0..511;{:112}{117:}
DELTA:FIXWORD;{:117}{121:}BC:BYTE;EC:BYTE;LH:BYTE;LF:0..32767;
NOTFOUND:BOOLEAN;{:121}{124:}J:0..MAXHEADERBYT;P:POINTER;Q:1..4;
PARPTR:0..MAXPARAMWORD;{:124}PROCEDURE INITIALIZE;VAR{19:}K:0..127;{:19}
{40:}H:0..100;{:40}{69:}D:HEADERINDEX;{:69}{73:}C:BYTE;{:73}
BEGIN WRITELN(TTY,'This is PLtoTF, Version 1.3');{6:}RESET(PLFILE);{:6}
{16:}REWRITE(TFMFILE,'','/B:8');{:16}{20:}
FOR K:=0 TO 127 DO XORD[CHR(K)]:=127;XORD[' ']:=32;XORD['!']:=33;
XORD['"']:=34;XORD['#']:=35;XORD['$']:=36;XORD['%']:=37;XORD['&']:=38;
XORD['''']:=39;XORD['(']:=40;XORD[')']:=41;XORD['*']:=42;XORD['+']:=43;
XORD[',']:=44;XORD['-']:=45;XORD['.']:=46;XORD['/']:=47;XORD['0']:=48;
XORD['1']:=49;XORD['2']:=50;XORD['3']:=51;XORD['4']:=52;XORD['5']:=53;
XORD['6']:=54;XORD['7']:=55;XORD['8']:=56;XORD['9']:=57;XORD[':']:=58;
XORD[';']:=59;XORD['<']:=60;XORD['=']:=61;XORD['>']:=62;XORD['?']:=63;
XORD['@']:=64;XORD['A']:=65;XORD['B']:=66;XORD['C']:=67;XORD['D']:=68;
XORD['E']:=69;XORD['F']:=70;XORD['G']:=71;XORD['H']:=72;XORD['I']:=73;
XORD['J']:=74;XORD['K']:=75;XORD['L']:=76;XORD['M']:=77;XORD['N']:=78;
XORD['O']:=79;XORD['P']:=80;XORD['Q']:=81;XORD['R']:=82;XORD['S']:=83;
XORD['T']:=84;XORD['U']:=85;XORD['V']:=86;XORD['W']:=87;XORD['X']:=88;
XORD['Y']:=89;XORD['Z']:=90;XORD['[']:=91;XORD['\']:=92;XORD[']']:=93;
XORD['↑']:=94;XORD['_']:=95;XORD['`']:=96;XORD['a']:=97;XORD['b']:=98;
XORD['c']:=99;XORD['d']:=100;XORD['e']:=101;XORD['f']:=102;
XORD['g']:=103;XORD['h']:=104;XORD['i']:=105;XORD['j']:=106;
XORD['k']:=107;XORD['l']:=108;XORD['m']:=109;XORD['n']:=110;
XORD['o']:=111;XORD['p']:=112;XORD['q']:=113;XORD['r']:=114;
XORD['s']:=115;XORD['t']:=116;XORD['u']:=117;XORD['v']:=118;
XORD['w']:=119;XORD['x']:=120;XORD['y']:=121;XORD['z']:=122;
XORD['{']:=123;XORD['|']:=124;XORD['}']:=125;XORD['~']:=126;{:20}{22:}
LINE:=0;GOODINDENT:=0;INDENT:=0;LEVEL:=0;{:22}{24:}LIMIT:=0;LOC:=0;
LEFTLN:=TRUE;RIGHTLN:=TRUE;INPUTHASENDE:=FALSE;{:24}{26:}CHARSONLINE:=0;
{:26}{37:}STARTPTR:=1;START[1]:=0;DICTPTR:=0;{:37}{41:}
FOR H:=0 TO 100 DO HASH[H]:=0;{:41}{70:}
FOR D:=0 TO 18*4-1 DO HEADERBYTES[D]:=0;HEADERBYTES[8]:=11;
HEADERBYTES[9]:=85;HEADERBYTES[10]:=78;HEADERBYTES[11]:=83;
HEADERBYTES[12]:=80;HEADERBYTES[13]:=69;HEADERBYTES[14]:=67;
HEADERBYTES[15]:=73;HEADERBYTES[16]:=70;HEADERBYTES[17]:=73;
HEADERBYTES[18]:=69;HEADERBYTES[19]:=68;
FOR D:=48 TO 59 DO HEADERBYTES[D]:=HEADERBYTES[D-40];
DESIGNSIZE:=10*1048576;DESIGNUNITS:=1048576;SEVENBITSAFE:=FALSE;
HEADERPTR:=18*4;NL:=0;UNUSEDLABEL:=FALSE;NK:=0;NE:=0;NP:=0;{:70}{74:}
FOR C:=0 TO 255 DO BEGIN CHARWD[C]:=0;CHARHT[C]:=0;CHARDP[C]:=0;
CHARIC[C]:=0;CHARTAG[C]:=0;CHARREMAINDE[C]:=0;END;MEMORY[0]:=2147483647;
MEMORY[1]:=0;LINK[1]:=0;MEMORY[2]:=0;LINK[2]:=0;MEMORY[3]:=0;LINK[3]:=0;
MEMORY[4]:=0;LINK[4]:=0;MEMPTR:=4;{:74}END;{:2}{27:}
PROCEDURE SHOWERRORCON;VAR K:0..BUFSIZE;
BEGIN WRITELN(TTY,' (line ',LINE:1,').');
IF NOT LEFTLN THEN WRITE(TTY,'...');
FOR K:=1 TO LOC DO WRITE(TTY,BUFFER[K]);WRITELN(TTY,' ');
IF NOT LEFTLN THEN WRITE(TTY,'   ');FOR K:=1 TO LOC DO WRITE(TTY,' ');
FOR K:=LOC+1 TO LIMIT DO WRITE(TTY,BUFFER[K]);
IF RIGHTLN THEN WRITELN(TTY,' ')ELSE WRITELN(TTY,'...');CHARSONLINE:=0;
END;{:27}{28:}PROCEDURE FILLBUFFER;BEGIN LEFTLN:=RIGHTLN;LIMIT:=0;
LOC:=0;IF EOF(PLFILE)THEN BEGIN LIMIT:=1;BUFFER[1]:=')';LINE:=LINE+1;
INPUTHASENDE:=TRUE;
END ELSE BEGIN IF LEFTLN THEN BEGIN IF LINE>0 THEN READLN(PLFILE);
LINE:=LINE+1;END;
WHILE(LIMIT<BUFSIZE-1)AND(NOT EOLN(PLFILE))DO BEGIN LIMIT:=LIMIT+1;
READ(PLFILE,BUFFER[LIMIT]);
IF BUFFER[LIMIT]=CHR(9)THEN BUFFER[LIMIT]:=' ';END;BUFFER[LIMIT+1]:=' ';
RIGHTLN:=EOLN(PLFILE);IF LEFTLN THEN{29:}
BEGIN WHILE(LOC<LIMIT)AND(BUFFER[LOC+1]=' ')DO LOC:=LOC+1;
IF LOC<LIMIT THEN BEGIN IF LEVEL=0 THEN IF LOC=0 THEN GOODINDENT:=
GOODINDENT+1 ELSE BEGIN IF GOODINDENT>=10 THEN BEGIN IF CHARSONLINE>0
THEN WRITELN(TTY,' ');
WRITE(TTY,'Warning: Indented line occurred at level zero');SHOWERRORCON;
END;GOODINDENT:=0;INDENT:=0;
END ELSE IF INDENT=0 THEN IF(LOC DIV LEVEL)*LEVEL=LOC THEN BEGIN INDENT
:=LOC DIV LEVEL;GOODINDENT:=1;
END ELSE GOODINDENT:=0 ELSE IF INDENT*LEVEL=LOC THEN GOODINDENT:=
GOODINDENT+1 ELSE BEGIN IF GOODINDENT>=10 THEN BEGIN IF CHARSONLINE>0
THEN WRITELN(TTY,' ');WRITE(TTY,'Warning: Inconsistent indentation; ',
'you are at parenthesis level ',LEVEL:1);SHOWERRORCON;END;GOODINDENT:=0;
INDENT:=0;END;END;END{:29};END;END;{:28}{31:}PROCEDURE GETLETTERORD;
BEGIN WHILE(LOC=LIMIT)AND(NOT RIGHTLN)DO FILLBUFFER;
IF LOC=LIMIT THEN CURCHAR:=32 ELSE BEGIN CURCHAR:=XORD[BUFFER[LOC+1]];
IF CURCHAR>=97 THEN CURCHAR:=CURCHAR-32;
IF((CURCHAR>=48)AND(CURCHAR<=57))OR((CURCHAR>=65)AND(CURCHAR<=90))THEN
LOC:=LOC+1 ELSE CURCHAR:=32;END;END;{:31}{32:}PROCEDURE GETNEXT;
BEGIN WHILE LOC=LIMIT DO FILLBUFFER;LOC:=LOC+1;
CURCHAR:=XORD[BUFFER[LOC]];
IF CURCHAR>=97 THEN IF CURCHAR<=122 THEN CURCHAR:=CURCHAR-32 ELSE BEGIN
IF CURCHAR=127 THEN BEGIN BEGIN IF CHARSONLINE>0 THEN WRITELN(TTY,' ');
WRITE(TTY,'Illegal character in the file');SHOWERRORCON;END;CURCHAR:=63;
END;END ELSE IF(CURCHAR<=41)AND(CURCHAR>=40)THEN LOC:=LOC-1;END;{:32}
{33:}PROCEDURE SKIPTOENDOFI;VAR L:INTEGER;BEGIN L:=LEVEL;
WHILE LEVEL>=L DO BEGIN WHILE LOC=LIMIT DO FILLBUFFER;LOC:=LOC+1;
IF BUFFER[LOC]=')'THEN LEVEL:=LEVEL-1 ELSE IF BUFFER[LOC]='('THEN LEVEL
:=LEVEL+1;END;
IF INPUTHASENDE THEN BEGIN IF CHARSONLINE>0 THEN WRITELN(TTY,' ');
WRITE(TTY,'File ended unexpectedly: No closing ")"');SHOWERRORCON;END;
CURCHAR:=32;END;{:33}{35:}PROCEDURE FINISHTHEPRO;
BEGIN WHILE CURCHAR=32 DO GETNEXT;
IF CURCHAR<>41 THEN BEGIN IF CHARSONLINE>0 THEN WRITELN(TTY,' ');
WRITE(TTY,'Junk after property value will be ignored');SHOWERRORCON;END;
SKIPTOENDOFI;END;{:35}{42:}PROCEDURE LOOKUP;VAR K:0..20;J:0..500;
NOTFOUND:BOOLEAN;BEGIN{43:}CURHASH:=CURNAME[1];
FOR K:=2 TO NAMELENGTH DO CURHASH:=(CURHASH+CURHASH+CURNAME[K])MOD 101{:
43};NOTFOUND:=TRUE;
WHILE NOTFOUND DO BEGIN IF CURHASH=0 THEN CURHASH:=100 ELSE CURHASH:=
CURHASH-1;
IF HASH[CURHASH]=0 THEN NOTFOUND:=FALSE ELSE BEGIN J:=START[HASH[CURHASH
]];IF START[HASH[CURHASH]+1]=J+NAMELENGTH THEN BEGIN NOTFOUND:=FALSE;
FOR K:=1 TO NAMELENGTH DO IF DICTIONARY[J+K-1]<>CURNAME[K]THEN NOTFOUND
:=TRUE;END;END;END;NAMEPTR:=HASH[CURHASH];END;{:42}{45:}
PROCEDURE ENTERNAME(V:BYTE);VAR K:0..20;
BEGIN FOR K:=1 TO NAMELENGTH DO CURNAME[K]:=CURNAME[K+20-NAMELENGTH];
LOOKUP;HASH[CURHASH]:=STARTPTR;EQUIV[STARTPTR]:=V;
FOR K:=1 TO NAMELENGTH DO BEGIN DICTIONARY[DICTPTR]:=CURNAME[K];
DICTPTR:=DICTPTR+1;END;STARTPTR:=STARTPTR+1;START[STARTPTR]:=DICTPTR;
END;{:45}{49:}PROCEDURE GETNAME;BEGIN LOC:=LOC+1;LEVEL:=LEVEL+1;
CURCHAR:=32;WHILE CURCHAR=32 DO GETNEXT;
IF(CURCHAR>41)OR(CURCHAR<40)THEN LOC:=LOC-1;NAMELENGTH:=0;GETLETTERORD;
WHILE CURCHAR<>32 DO BEGIN IF NAMELENGTH=20 THEN CURNAME[1]:=88 ELSE
NAMELENGTH:=NAMELENGTH+1;CURNAME[NAMELENGTH]:=CURCHAR;GETLETTERORD;END;
LOOKUP;IF NAMEPTR=0 THEN BEGIN IF CHARSONLINE>0 THEN WRITELN(TTY,' ');
WRITE(TTY,'Sorry, I don''t know that property name');SHOWERRORCON;END;
CURCODE:=EQUIV[NAMEPTR];END;{:49}{51:}FUNCTION GETBYTE:BYTE;
VAR ACC:INTEGER;T:ASCIICODE;BEGIN REPEAT GETNEXT;UNTIL CURCHAR<>32;
T:=CURCHAR;ACC:=0;REPEAT GETNEXT;UNTIL CURCHAR<>32;IF T=67 THEN{52:}
IF(CURCHAR>=33)AND(CURCHAR<=126)AND((CURCHAR<40)OR(CURCHAR>41))THEN
BEGIN ACC:=XORD[BUFFER[LOC]];CURCHAR:=32;
END ELSE BEGIN BEGIN IF CHARSONLINE>0 THEN WRITELN(TTY,' ');
WRITE(TTY,'"C" value must be standard ascii and not a paren');
SHOWERRORCON;END;REPEAT GETNEXT UNTIL(CURCHAR=40)OR(CURCHAR=41);END{:52}
ELSE IF T=68 THEN{53:}
WHILE(CURCHAR>=48)AND(CURCHAR<=57)DO BEGIN ACC:=ACC*10+CURCHAR-48;
IF ACC>255 THEN BEGIN BEGIN BEGIN IF CHARSONLINE>0 THEN WRITELN(TTY,' ')
;WRITE(TTY,'This value shouldn''t exceed 255');SHOWERRORCON;END;
REPEAT GETNEXT UNTIL(CURCHAR=40)OR(CURCHAR=41);END;ACC:=0;CURCHAR:=32;
END ELSE GETNEXT;END{:53}ELSE IF T=79 THEN{54:}
WHILE(CURCHAR>=48)AND(CURCHAR<=55)DO BEGIN ACC:=ACC*8+CURCHAR-48;
IF ACC>255 THEN BEGIN BEGIN BEGIN IF CHARSONLINE>0 THEN WRITELN(TTY,' ')
;WRITE(TTY,'This value shouldn''t exceed ''377');SHOWERRORCON;END;
REPEAT GETNEXT UNTIL(CURCHAR=40)OR(CURCHAR=41);END;ACC:=0;CURCHAR:=32;
END ELSE GETNEXT;END{:54}ELSE IF T=72 THEN{55:}
WHILE((CURCHAR>=48)AND(CURCHAR<=57))OR((CURCHAR>=65)AND(CURCHAR<=70))DO
BEGIN IF CURCHAR>=65 THEN CURCHAR:=CURCHAR-7;ACC:=ACC*16+CURCHAR-48;
IF ACC>255 THEN BEGIN BEGIN BEGIN IF CHARSONLINE>0 THEN WRITELN(TTY,' ')
;WRITE(TTY,'This value shouldn''t exceed "FF');SHOWERRORCON;END;
REPEAT GETNEXT UNTIL(CURCHAR=40)OR(CURCHAR=41);END;ACC:=0;CURCHAR:=32;
END ELSE GETNEXT;END{:55}ELSE IF T=70 THEN{56:}
BEGIN IF CURCHAR=66 THEN ACC:=2 ELSE IF CURCHAR=76 THEN ACC:=4 ELSE IF
CURCHAR<>77 THEN ACC:=18;GETNEXT;
IF CURCHAR=73 THEN ACC:=ACC+1 ELSE IF CURCHAR<>82 THEN ACC:=18;GETNEXT;
IF CURCHAR=67 THEN ACC:=ACC+6 ELSE IF CURCHAR=69 THEN ACC:=ACC+12 ELSE
IF CURCHAR<>82 THEN ACC:=18;
IF ACC>=18 THEN BEGIN BEGIN BEGIN IF CHARSONLINE>0 THEN WRITELN(TTY,' ')
;WRITE(TTY,'Illegal face code, I changed it to MRR');SHOWERRORCON;END;
REPEAT GETNEXT UNTIL(CURCHAR=40)OR(CURCHAR=41);END;ACC:=0;END;
CURCHAR:=32;END{:56}
ELSE BEGIN BEGIN IF CHARSONLINE>0 THEN WRITELN(TTY,' ');
WRITE(TTY,'You need "C" or "D" or "O" or "H" or "F" here');SHOWERRORCON;
END;REPEAT GETNEXT UNTIL(CURCHAR=40)OR(CURCHAR=41);END;GETBYTE:=ACC;END;
{:51}{59:}PROCEDURE GETFOURBYTES;VAR C:INTEGER;R:INTEGER;Q:INTEGER;
BEGIN REPEAT GETNEXT;UNTIL CURCHAR<>32;R:=0;CURBYTES.B0:=0;
CURBYTES.B1:=0;CURBYTES.B2:=0;CURBYTES.B3:=0;
IF CURCHAR=72 THEN R:=16 ELSE IF CURCHAR=79 THEN R:=8 ELSE BEGIN BEGIN
IF CHARSONLINE>0 THEN WRITELN(TTY,' ');
WRITE(TTY,'An octal ("O") or hex ("H") value is needed here');
SHOWERRORCON;END;REPEAT GETNEXT UNTIL(CURCHAR=40)OR(CURCHAR=41);END;
IF R>0 THEN BEGIN Q:=256 DIV R;REPEAT GETNEXT;UNTIL CURCHAR<>32;
WHILE((CURCHAR>=48)AND(CURCHAR<=57))OR((CURCHAR>=65)AND(CURCHAR<=70))DO{
60:}BEGIN IF CURCHAR>=65 THEN CURCHAR:=CURCHAR-7;
C:=(R*CURBYTES.B0)+(CURBYTES.B1 DIV Q);
IF C>255 THEN BEGIN CURBYTES.B0:=0;CURBYTES.B1:=0;CURBYTES.B2:=0;
CURBYTES.B3:=0;
IF R=8 THEN BEGIN BEGIN IF CHARSONLINE>0 THEN WRITELN(TTY,' ');
WRITE(TTY,'Sorry, the maximum octal value is O 37777777777');
SHOWERRORCON;END;REPEAT GETNEXT UNTIL(CURCHAR=40)OR(CURCHAR=41);
END ELSE BEGIN BEGIN IF CHARSONLINE>0 THEN WRITELN(TTY,' ');
WRITE(TTY,'Sorry, the maximum hex value is H FFFFFFFF');SHOWERRORCON;
END;REPEAT GETNEXT UNTIL(CURCHAR=40)OR(CURCHAR=41);END;
END ELSE IF CURCHAR>=48+R THEN BEGIN BEGIN IF CHARSONLINE>0 THEN WRITELN
(TTY,' ');WRITE(TTY,'Illegal digit');SHOWERRORCON;END;
REPEAT GETNEXT UNTIL(CURCHAR=40)OR(CURCHAR=41);
END ELSE BEGIN CURBYTES.B0:=C;
CURBYTES.B1:=(R*(CURBYTES.B1 MOD Q))+(CURBYTES.B2 DIV Q);
CURBYTES.B2:=(R*(CURBYTES.B2 MOD Q))+(CURBYTES.B3 DIV Q);
CURBYTES.B3:=(R*(CURBYTES.B3 MOD Q))+CURCHAR-48;GETNEXT;END;END;{:60};
END;END;{:59}{62:}FUNCTION GETFIX:FIXWORD;VAR NEGATIVE:BOOLEAN;
ACC:INTEGER;INTPART:INTEGER;J:0..7;BEGIN REPEAT GETNEXT;
UNTIL CURCHAR<>32;NEGATIVE:=FALSE;ACC:=0;
IF(CURCHAR<>82)AND(CURCHAR<>68)THEN BEGIN BEGIN IF CHARSONLINE>0 THEN
WRITELN(TTY,' ');WRITE(TTY,'An "R" or "D" value is needed here');
SHOWERRORCON;END;REPEAT GETNEXT UNTIL(CURCHAR=40)OR(CURCHAR=41);
END ELSE BEGIN{63:}REPEAT GETNEXT;IF CURCHAR=45 THEN BEGIN CURCHAR:=32;
NEGATIVE:=TRUE;END ELSE IF CURCHAR=43 THEN CURCHAR:=32;
UNTIL CURCHAR<>32{:63};WHILE(CURCHAR>=48)AND(CURCHAR<=57)DO{64:}
BEGIN ACC:=ACC*10+CURCHAR-48;
IF ACC>=1024 THEN BEGIN BEGIN BEGIN IF CHARSONLINE>0 THEN WRITELN(TTY,
' ');WRITE(TTY,'Real constants must be less than 1024');SHOWERRORCON;
END;REPEAT GETNEXT UNTIL(CURCHAR=40)OR(CURCHAR=41);END;ACC:=0;
CURCHAR:=32;END ELSE GETNEXT;END{:64};INTPART:=ACC;ACC:=0;
IF CURCHAR=46 THEN{66:}BEGIN J:=0;GETNEXT;
WHILE(CURCHAR>=48)AND(CURCHAR<=57)DO BEGIN IF J<7 THEN BEGIN J:=J+1;
FRACTIONDIGI[J]:=2097152*(CURCHAR-48);END;GETNEXT;END;ACC:=0;
WHILE J>0 DO BEGIN ACC:=FRACTIONDIGI[J]+(ACC DIV 10);J:=J-1;END;
ACC:=(ACC+10)DIV 20;END{:66};
IF(ACC>=1048576)AND(INTPART=1023)THEN BEGIN BEGIN IF CHARSONLINE>0 THEN
WRITELN(TTY,' ');WRITE(TTY,'Real constants must be less than 1024');
SHOWERRORCON;END;REPEAT GETNEXT UNTIL(CURCHAR=40)OR(CURCHAR=41);
END ELSE ACC:=INTPART*1048576+ACC;END;
IF NEGATIVE THEN GETFIX:=-ACC ELSE GETFIX:=ACC;END;{:62}{75:}
FUNCTION SORTIN(H:POINTER;D:FIXWORD):POINTER;VAR P:POINTER;
BEGIN IF(D=0)AND(H<>1)THEN SORTIN:=0 ELSE BEGIN P:=H;
WHILE D>=MEMORY[LINK[P]]DO P:=LINK[P];
IF(D=MEMORY[P])AND(P<>H)THEN SORTIN:=P ELSE IF MEMPTR=1032 THEN BEGIN
BEGIN IF CHARSONLINE>0 THEN WRITELN(TTY,' ');
WRITE(TTY,'Memory overflow: more than 1028 widths, etc');SHOWERRORCON;
END;WRITELN(TTY,'Congratulations! It''s hard to make this error.');
SORTIN:=P;END ELSE BEGIN MEMPTR:=MEMPTR+1;MEMORY[MEMPTR]:=D;
LINK[MEMPTR]:=LINK[P];LINK[P]:=MEMPTR;MEMORY[H]:=MEMORY[H]+1;
SORTIN:=MEMPTR;END;END;END;{:75}{77:}FUNCTION MINCOVER(H:POINTER;
D:FIXWORD):INTEGER;VAR P:POINTER;L:FIXWORD;M:INTEGER;BEGIN M:=0;
P:=LINK[H];NEXTD:=MEMORY[0];WHILE P<>0 DO BEGIN M:=M+1;L:=MEMORY[P];
WHILE MEMORY[LINK[P]]<=L+D DO P:=LINK[P];P:=LINK[P];
IF MEMORY[P]-L<NEXTD THEN NEXTD:=MEMORY[P]-L;END;MINCOVER:=M;END;{:77}
{78:}FUNCTION SHORTEN(H:POINTER;M:INTEGER):FIXWORD;VAR D:FIXWORD;
K:INTEGER;BEGIN IF MEMORY[H]>M THEN BEGIN K:=MINCOVER(H,0);D:=NEXTD;
REPEAT D:=D+D;K:=MINCOVER(H,D);UNTIL K<=M;D:=D DIV 2;K:=MINCOVER(H,D);
WHILE K>M DO BEGIN D:=NEXTD;K:=MINCOVER(H,D);END;SHORTEN:=D;
END ELSE SHORTEN:=0;END;{:78}{80:}PROCEDURE SETINDICES(H:POINTER;
D:FIXWORD);VAR P:POINTER;Q:POINTER;M:BYTE;L:FIXWORD;BEGIN Q:=H;
P:=LINK[Q];M:=0;WHILE P<>0 DO BEGIN M:=M+1;L:=MEMORY[P];INDEX[P]:=M;
WHILE MEMORY[LINK[P]]<=L+D DO BEGIN P:=LINK[P];INDEX[P]:=M;END;
LINK[Q]:=P;MEMORY[P]:=(L+MEMORY[P])DIV 2;Q:=P;P:=LINK[P];END;
MEMORY[H]:=M;END;{:80}{83:}PROCEDURE JUNKERROR;
BEGIN BEGIN IF CHARSONLINE>0 THEN WRITELN(TTY,' ');
WRITE(TTY,'There''s junk here that is not in parentheses');SHOWERRORCON;
END;REPEAT GETNEXT UNTIL(CURCHAR=40)OR(CURCHAR=41);END;{:83}{86:}
PROCEDURE READFOURBYTE(L:HEADERINDEX);BEGIN GETFOURBYTES;
HEADERBYTES[L]:=CURBYTES.B0;HEADERBYTES[L+1]:=CURBYTES.B1;
HEADERBYTES[L+2]:=CURBYTES.B2;HEADERBYTES[L+3]:=CURBYTES.B3;END;{:86}
{87:}PROCEDURE READBCPL(L:HEADERINDEX;N:BYTE);VAR K:HEADERINDEX;
BEGIN K:=L;WHILE CURCHAR=32 DO GETNEXT;
WHILE(CURCHAR<>40)AND(CURCHAR<>41)DO BEGIN IF K<L+N THEN K:=K+1;
IF K<L+N THEN HEADERBYTES[K]:=CURCHAR;GETNEXT;END;
IF K=L+N THEN BEGIN BEGIN IF CHARSONLINE>0 THEN WRITELN(TTY,' ');
WRITE(TTY,'String is too long; its first ',N-1:1,
' characters will be kept');SHOWERRORCON;END;K:=K-1;END;
HEADERBYTES[L]:=K-L;WHILE K<L+N-1 DO BEGIN K:=K+1;HEADERBYTES[K]:=0;END;
END;{:87}{96:}PROCEDURE CHECKTAG(C:BYTE);BEGIN CASE CHARTAG[C]OF 0:;
1:BEGIN IF CHARSONLINE>0 THEN WRITELN(TTY,' ');
WRITE(TTY,'This character already appeared in a LIGTABLE LABEL');
SHOWERRORCON;END;2:BEGIN IF CHARSONLINE>0 THEN WRITELN(TTY,' ');
WRITE(TTY,'This character already has a NEXTLARGER spec');SHOWERRORCON;
END;3:BEGIN IF CHARSONLINE>0 THEN WRITELN(TTY,' ');
WRITE(TTY,'This character already has a VARCHAR spec');SHOWERRORCON;END;
END;END;{:96}{106:}PROCEDURE PRINTOCTAL(C:BYTE);
BEGIN WRITE(TTY,'''',(C DIV 64):1,((C DIV 8)MOD 8):1,(C MOD 8):1);END;
{:106}{127:}PROCEDURE OUTSCALED(X:FIXWORD);VAR Z:REAL;N:BYTE;M:0..65535;
BEGIN IF ABS(X/DESIGNUNITS)>=16.0 THEN BEGIN WRITELN(TTY,
'The relative dimension',X/1048576:1:3,' is too large.');
WRITE(TTY,'  (Must be less than 16*designsize');
IF DESIGNUNITS<>1048576 THEN WRITE(TTY,' =',DESIGNUNITS/65536:1:3,
' designunits');WRITELN(TTY,')');X:=0;END;
IF X<0 THEN WRITE(TFMFILE,255)ELSE WRITE(TFMFILE,0);
IF DESIGNUNITS=1048576 THEN BEGIN IF X<0 THEN X:=X+16777216;
N:=X DIV 65536;M:=X MOD 65536;END ELSE BEGIN Z:=(X/DESIGNUNITS)*16.0;
IF Z<0 THEN Z:=Z+256.0;N:=TRUNC(Z);M:=TRUNC(65536.0*(Z-N));END;
WRITE(TFMFILE,N);WRITE(TFMFILE,M DIV 256);WRITE(TFMFILE,M MOD 256);END;
{:127}{133:}PROCEDURE PARAMENTER;BEGIN{48:}NAMELENGTH:=5;
CURNAME[16]:=83;CURNAME[17]:=76;CURNAME[18]:=65;CURNAME[19]:=78;
CURNAME[20]:=84;ENTERNAME(21);NAMELENGTH:=5;CURNAME[16]:=83;
CURNAME[17]:=80;CURNAME[18]:=65;CURNAME[19]:=67;CURNAME[20]:=69;
ENTERNAME(22);NAMELENGTH:=7;CURNAME[14]:=83;CURNAME[15]:=84;
CURNAME[16]:=82;CURNAME[17]:=69;CURNAME[18]:=84;CURNAME[19]:=67;
CURNAME[20]:=72;ENTERNAME(23);NAMELENGTH:=6;CURNAME[15]:=83;
CURNAME[16]:=72;CURNAME[17]:=82;CURNAME[18]:=73;CURNAME[19]:=78;
CURNAME[20]:=75;ENTERNAME(24);NAMELENGTH:=7;CURNAME[14]:=88;
CURNAME[15]:=72;CURNAME[16]:=69;CURNAME[17]:=73;CURNAME[18]:=71;
CURNAME[19]:=72;CURNAME[20]:=84;ENTERNAME(25);NAMELENGTH:=4;
CURNAME[17]:=81;CURNAME[18]:=85;CURNAME[19]:=65;CURNAME[20]:=68;
ENTERNAME(26);NAMELENGTH:=10;CURNAME[11]:=69;CURNAME[12]:=88;
CURNAME[13]:=84;CURNAME[14]:=82;CURNAME[15]:=65;CURNAME[16]:=83;
CURNAME[17]:=80;CURNAME[18]:=65;CURNAME[19]:=67;CURNAME[20]:=69;
ENTERNAME(27);NAMELENGTH:=4;CURNAME[17]:=78;CURNAME[18]:=85;
CURNAME[19]:=77;CURNAME[20]:=49;ENTERNAME(28);NAMELENGTH:=4;
CURNAME[17]:=78;CURNAME[18]:=85;CURNAME[19]:=77;CURNAME[20]:=50;
ENTERNAME(29);NAMELENGTH:=4;CURNAME[17]:=78;CURNAME[18]:=85;
CURNAME[19]:=77;CURNAME[20]:=51;ENTERNAME(30);NAMELENGTH:=6;
CURNAME[15]:=68;CURNAME[16]:=69;CURNAME[17]:=78;CURNAME[18]:=79;
CURNAME[19]:=77;CURNAME[20]:=49;ENTERNAME(31);NAMELENGTH:=6;
CURNAME[15]:=68;CURNAME[16]:=69;CURNAME[17]:=78;CURNAME[18]:=79;
CURNAME[19]:=77;CURNAME[20]:=50;ENTERNAME(32);NAMELENGTH:=4;
CURNAME[17]:=83;CURNAME[18]:=85;CURNAME[19]:=80;CURNAME[20]:=49;
ENTERNAME(33);NAMELENGTH:=4;CURNAME[17]:=83;CURNAME[18]:=85;
CURNAME[19]:=80;CURNAME[20]:=50;ENTERNAME(34);NAMELENGTH:=4;
CURNAME[17]:=83;CURNAME[18]:=85;CURNAME[19]:=80;CURNAME[20]:=51;
ENTERNAME(35);NAMELENGTH:=4;CURNAME[17]:=83;CURNAME[18]:=85;
CURNAME[19]:=66;CURNAME[20]:=49;ENTERNAME(36);NAMELENGTH:=4;
CURNAME[17]:=83;CURNAME[18]:=85;CURNAME[19]:=66;CURNAME[20]:=50;
ENTERNAME(37);NAMELENGTH:=7;CURNAME[14]:=83;CURNAME[15]:=85;
CURNAME[16]:=80;CURNAME[17]:=68;CURNAME[18]:=82;CURNAME[19]:=79;
CURNAME[20]:=80;ENTERNAME(38);NAMELENGTH:=7;CURNAME[14]:=83;
CURNAME[15]:=85;CURNAME[16]:=66;CURNAME[17]:=68;CURNAME[18]:=82;
CURNAME[19]:=79;CURNAME[20]:=80;ENTERNAME(39);NAMELENGTH:=6;
CURNAME[15]:=68;CURNAME[16]:=69;CURNAME[17]:=76;CURNAME[18]:=73;
CURNAME[19]:=77;CURNAME[20]:=49;ENTERNAME(40);NAMELENGTH:=6;
CURNAME[15]:=68;CURNAME[16]:=69;CURNAME[17]:=76;CURNAME[18]:=73;
CURNAME[19]:=77;CURNAME[20]:=50;ENTERNAME(41);NAMELENGTH:=10;
CURNAME[11]:=65;CURNAME[12]:=88;CURNAME[13]:=73;CURNAME[14]:=83;
CURNAME[15]:=72;CURNAME[16]:=69;CURNAME[17]:=73;CURNAME[18]:=71;
CURNAME[19]:=72;CURNAME[20]:=84;ENTERNAME(42);NAMELENGTH:=20;
CURNAME[1]:=68;CURNAME[2]:=69;CURNAME[3]:=70;CURNAME[4]:=65;
CURNAME[5]:=85;CURNAME[6]:=76;CURNAME[7]:=84;CURNAME[8]:=82;
CURNAME[9]:=85;CURNAME[10]:=76;CURNAME[11]:=69;CURNAME[12]:=84;
CURNAME[13]:=72;CURNAME[14]:=73;CURNAME[15]:=67;CURNAME[16]:=75;
CURNAME[17]:=78;CURNAME[18]:=69;CURNAME[19]:=83;CURNAME[20]:=83;
ENTERNAME(28);NAMELENGTH:=13;CURNAME[8]:=66;CURNAME[9]:=73;
CURNAME[10]:=71;CURNAME[11]:=79;CURNAME[12]:=80;CURNAME[13]:=83;
CURNAME[14]:=80;CURNAME[15]:=65;CURNAME[16]:=67;CURNAME[17]:=73;
CURNAME[18]:=78;CURNAME[19]:=71;CURNAME[20]:=49;ENTERNAME(29);
NAMELENGTH:=13;CURNAME[8]:=66;CURNAME[9]:=73;CURNAME[10]:=71;
CURNAME[11]:=79;CURNAME[12]:=80;CURNAME[13]:=83;CURNAME[14]:=80;
CURNAME[15]:=65;CURNAME[16]:=67;CURNAME[17]:=73;CURNAME[18]:=78;
CURNAME[19]:=71;CURNAME[20]:=50;ENTERNAME(30);NAMELENGTH:=13;
CURNAME[8]:=66;CURNAME[9]:=73;CURNAME[10]:=71;CURNAME[11]:=79;
CURNAME[12]:=80;CURNAME[13]:=83;CURNAME[14]:=80;CURNAME[15]:=65;
CURNAME[16]:=67;CURNAME[17]:=73;CURNAME[18]:=78;CURNAME[19]:=71;
CURNAME[20]:=51;ENTERNAME(31);NAMELENGTH:=13;CURNAME[8]:=66;
CURNAME[9]:=73;CURNAME[10]:=71;CURNAME[11]:=79;CURNAME[12]:=80;
CURNAME[13]:=83;CURNAME[14]:=80;CURNAME[15]:=65;CURNAME[16]:=67;
CURNAME[17]:=73;CURNAME[18]:=78;CURNAME[19]:=71;CURNAME[20]:=52;
ENTERNAME(32);NAMELENGTH:=13;CURNAME[8]:=66;CURNAME[9]:=73;
CURNAME[10]:=71;CURNAME[11]:=79;CURNAME[12]:=80;CURNAME[13]:=83;
CURNAME[14]:=80;CURNAME[15]:=65;CURNAME[16]:=67;CURNAME[17]:=73;
CURNAME[18]:=78;CURNAME[19]:=71;CURNAME[20]:=53;ENTERNAME(33);{:48};END;
PROCEDURE NAMEENTER;BEGIN{47:}EQUIV[0]:=0;NAMELENGTH:=8;CURNAME[13]:=67;
CURNAME[14]:=72;CURNAME[15]:=69;CURNAME[16]:=67;CURNAME[17]:=75;
CURNAME[18]:=83;CURNAME[19]:=85;CURNAME[20]:=77;ENTERNAME(1);
NAMELENGTH:=10;CURNAME[11]:=68;CURNAME[12]:=69;CURNAME[13]:=83;
CURNAME[14]:=73;CURNAME[15]:=71;CURNAME[16]:=78;CURNAME[17]:=83;
CURNAME[18]:=73;CURNAME[19]:=90;CURNAME[20]:=69;ENTERNAME(2);
NAMELENGTH:=11;CURNAME[10]:=68;CURNAME[11]:=69;CURNAME[12]:=83;
CURNAME[13]:=73;CURNAME[14]:=71;CURNAME[15]:=78;CURNAME[16]:=85;
CURNAME[17]:=78;CURNAME[18]:=73;CURNAME[19]:=84;CURNAME[20]:=83;
ENTERNAME(3);NAMELENGTH:=12;CURNAME[9]:=67;CURNAME[10]:=79;
CURNAME[11]:=68;CURNAME[12]:=73;CURNAME[13]:=78;CURNAME[14]:=71;
CURNAME[15]:=83;CURNAME[16]:=67;CURNAME[17]:=72;CURNAME[18]:=69;
CURNAME[19]:=77;CURNAME[20]:=69;ENTERNAME(4);NAMELENGTH:=6;
CURNAME[15]:=70;CURNAME[16]:=65;CURNAME[17]:=77;CURNAME[18]:=73;
CURNAME[19]:=76;CURNAME[20]:=89;ENTERNAME(5);NAMELENGTH:=4;
CURNAME[17]:=70;CURNAME[18]:=65;CURNAME[19]:=67;CURNAME[20]:=69;
ENTERNAME(6);NAMELENGTH:=16;CURNAME[5]:=83;CURNAME[6]:=69;
CURNAME[7]:=86;CURNAME[8]:=69;CURNAME[9]:=78;CURNAME[10]:=66;
CURNAME[11]:=73;CURNAME[12]:=84;CURNAME[13]:=83;CURNAME[14]:=65;
CURNAME[15]:=70;CURNAME[16]:=69;CURNAME[17]:=70;CURNAME[18]:=76;
CURNAME[19]:=65;CURNAME[20]:=71;ENTERNAME(7);NAMELENGTH:=6;
CURNAME[15]:=72;CURNAME[16]:=69;CURNAME[17]:=65;CURNAME[18]:=68;
CURNAME[19]:=69;CURNAME[20]:=82;ENTERNAME(8);NAMELENGTH:=7;
CURNAME[14]:=84;CURNAME[15]:=69;CURNAME[16]:=88;CURNAME[17]:=73;
CURNAME[18]:=78;CURNAME[19]:=70;CURNAME[20]:=79;ENTERNAME(9);
NAMELENGTH:=8;CURNAME[13]:=76;CURNAME[14]:=73;CURNAME[15]:=71;
CURNAME[16]:=84;CURNAME[17]:=65;CURNAME[18]:=66;CURNAME[19]:=76;
CURNAME[20]:=69;ENTERNAME(10);NAMELENGTH:=9;CURNAME[12]:=67;
CURNAME[13]:=72;CURNAME[14]:=65;CURNAME[15]:=82;CURNAME[16]:=65;
CURNAME[17]:=67;CURNAME[18]:=84;CURNAME[19]:=69;CURNAME[20]:=82;
ENTERNAME(11);NAMELENGTH:=9;CURNAME[12]:=80;CURNAME[13]:=65;
CURNAME[14]:=82;CURNAME[15]:=65;CURNAME[16]:=77;CURNAME[17]:=69;
CURNAME[18]:=84;CURNAME[19]:=69;CURNAME[20]:=82;ENTERNAME(20);
NAMELENGTH:=6;CURNAME[15]:=67;CURNAME[16]:=72;CURNAME[17]:=65;
CURNAME[18]:=82;CURNAME[19]:=87;CURNAME[20]:=68;ENTERNAME(51);
NAMELENGTH:=6;CURNAME[15]:=67;CURNAME[16]:=72;CURNAME[17]:=65;
CURNAME[18]:=82;CURNAME[19]:=72;CURNAME[20]:=84;ENTERNAME(52);
NAMELENGTH:=6;CURNAME[15]:=67;CURNAME[16]:=72;CURNAME[17]:=65;
CURNAME[18]:=82;CURNAME[19]:=68;CURNAME[20]:=80;ENTERNAME(53);
NAMELENGTH:=6;CURNAME[15]:=67;CURNAME[16]:=72;CURNAME[17]:=65;
CURNAME[18]:=82;CURNAME[19]:=73;CURNAME[20]:=67;ENTERNAME(54);
NAMELENGTH:=10;CURNAME[11]:=78;CURNAME[12]:=69;CURNAME[13]:=88;
CURNAME[14]:=84;CURNAME[15]:=76;CURNAME[16]:=65;CURNAME[17]:=82;
CURNAME[18]:=71;CURNAME[19]:=69;CURNAME[20]:=82;ENTERNAME(55);
NAMELENGTH:=7;CURNAME[14]:=86;CURNAME[15]:=65;CURNAME[16]:=82;
CURNAME[17]:=67;CURNAME[18]:=72;CURNAME[19]:=65;CURNAME[20]:=82;
ENTERNAME(56);NAMELENGTH:=3;CURNAME[18]:=84;CURNAME[19]:=79;
CURNAME[20]:=80;ENTERNAME(57);NAMELENGTH:=3;CURNAME[18]:=77;
CURNAME[19]:=73;CURNAME[20]:=68;ENTERNAME(58);NAMELENGTH:=3;
CURNAME[18]:=66;CURNAME[19]:=79;CURNAME[20]:=84;ENTERNAME(59);
NAMELENGTH:=3;CURNAME[18]:=82;CURNAME[19]:=69;CURNAME[20]:=80;
ENTERNAME(60);NAMELENGTH:=3;CURNAME[18]:=69;CURNAME[19]:=88;
CURNAME[20]:=84;ENTERNAME(60);NAMELENGTH:=7;CURNAME[14]:=67;
CURNAME[15]:=79;CURNAME[16]:=77;CURNAME[17]:=77;CURNAME[18]:=69;
CURNAME[19]:=78;CURNAME[20]:=84;ENTERNAME(0);NAMELENGTH:=5;
CURNAME[16]:=76;CURNAME[17]:=65;CURNAME[18]:=66;CURNAME[19]:=69;
CURNAME[20]:=76;ENTERNAME(70);NAMELENGTH:=3;CURNAME[18]:=76;
CURNAME[19]:=73;CURNAME[20]:=71;ENTERNAME(71);NAMELENGTH:=3;
CURNAME[18]:=75;CURNAME[19]:=82;CURNAME[20]:=78;ENTERNAME(72);
NAMELENGTH:=4;CURNAME[17]:=83;CURNAME[18]:=84;CURNAME[19]:=79;
CURNAME[20]:=80;ENTERNAME(73);{:47};PARAMENTER;END;
PROCEDURE READLIGKERN;VAR KRNPTR:0..256;C:BYTE;BEGIN{94:}
BEGIN WHILE LEVEL=1 DO BEGIN WHILE CURCHAR=32 DO GETNEXT;
IF CURCHAR=40 THEN{95:}BEGIN GETNAME;
IF CURCODE=0 THEN SKIPTOENDOFI ELSE IF(CURCODE<70)OR(CURCODE>73)THEN
BEGIN BEGIN IF CHARSONLINE>0 THEN WRITELN(TTY,' ');
WRITE(TTY,'This property name doesn''t belong in a LIGTABLE list');
SHOWERRORCON;END;SKIPTOENDOFI;END ELSE BEGIN CASE CURCODE OF 70:{97:}
BEGIN C:=GETBYTE;CHECKTAG(C);
IF NL>255 THEN BEGIN IF CHARSONLINE>0 THEN WRITELN(TTY,' ');WRITE(TTY,
'LIGTABLE with more than 255 commands cannot have further labels');
SHOWERRORCON;END ELSE BEGIN CHARTAG[C]:=1;CHARREMAINDE[C]:=NL;
UNUSEDLABEL:=TRUE;END;END{:97};71:{98:}BEGIN LIGKERN[NL].B0:=0;
LIGKERN[NL].B1:=GETBYTE;LIGKERN[NL].B2:=0;LIGKERN[NL].B3:=GETBYTE;
IF NL=511 THEN BEGIN IF CHARSONLINE>0 THEN WRITELN(TTY,' ');
WRITE(TTY,'LIGTABLE should never exceed 511 LIG/KRN commands');
SHOWERRORCON;END ELSE NL:=NL+1;UNUSEDLABEL:=FALSE;END{:98};72:{100:}
BEGIN LIGKERN[NL].B0:=0;LIGKERN[NL].B1:=GETBYTE;LIGKERN[NL].B2:=128;
KERN[NK]:=GETFIX;KRNPTR:=0;
WHILE KERN[KRNPTR]<>KERN[NK]DO KRNPTR:=KRNPTR+1;
IF KRNPTR=NK THEN BEGIN IF NK<256 THEN NK:=NK+1 ELSE BEGIN BEGIN IF
CHARSONLINE>0 THEN WRITELN(TTY,' ');
WRITE(TTY,'At most 256 different kerns are allowed');SHOWERRORCON;END;
KRNPTR:=255;END;END;LIGKERN[NL].B3:=KRNPTR;
IF NL=511 THEN BEGIN IF CHARSONLINE>0 THEN WRITELN(TTY,' ');
WRITE(TTY,'LIGTABLE should never exceed 511 LIG/KRN commands');
SHOWERRORCON;END ELSE NL:=NL+1;UNUSEDLABEL:=FALSE;END{:100};73:{101:}
BEGIN IF NL=0 THEN BEGIN IF CHARSONLINE>0 THEN WRITELN(TTY,' ');
WRITE(TTY,'Why STOP? You haven''t started');SHOWERRORCON;
END ELSE BEGIN IF UNUSEDLABEL THEN BEGIN BEGIN IF CHARSONLINE>0 THEN
WRITELN(TTY,' ');WRITE(TTY,'STOP after LABEL invalidates the label');
SHOWERRORCON;END;
FOR C:=0 TO 255 DO IF(CHARTAG[C]=1)AND(CHARREMAINDE[C]=NL)THEN CHARTAG[C
]:=0;UNUSEDLABEL:=FALSE;END;LIGKERN[NL-1].B0:=128;END;END{:101};END;
FINISHTHEPRO;END;END{:95}
ELSE IF CURCHAR=41 THEN SKIPTOENDOFI ELSE JUNKERROR;END;
BEGIN LOC:=LOC-1;LEVEL:=LEVEL+1;CURCHAR:=41;END;END{:94};END;
PROCEDURE READCHARINFO;BEGIN{102:}BEGIN C:=GETBYTE;{107:}
BEGIN IF CHARSONLINE=8 THEN BEGIN WRITELN(TTY,' ');CHARSONLINE:=1;
END ELSE BEGIN IF CHARSONLINE>0 THEN WRITE(TTY,' ');
CHARSONLINE:=CHARSONLINE+1;END;PRINTOCTAL(C);END{:107};
WHILE LEVEL=1 DO BEGIN WHILE CURCHAR=32 DO GETNEXT;
IF CURCHAR=40 THEN{103:}BEGIN GETNAME;
IF CURCODE=0 THEN SKIPTOENDOFI ELSE IF(CURCODE<51)OR(CURCODE>56)THEN
BEGIN BEGIN IF CHARSONLINE>0 THEN WRITELN(TTY,' ');
WRITE(TTY,'This property name doesn''t belong in a CHARACTER list');
SHOWERRORCON;END;SKIPTOENDOFI;
END ELSE BEGIN CASE CURCODE OF 51:CHARWD[C]:=SORTIN(1,GETFIX);
52:CHARHT[C]:=SORTIN(2,GETFIX);53:CHARDP[C]:=SORTIN(3,GETFIX);
54:CHARIC[C]:=SORTIN(4,GETFIX);55:BEGIN CHECKTAG(C);CHARTAG[C]:=2;
CHARREMAINDE[C]:=GETBYTE;END;56:{104:}
BEGIN IF NE=256 THEN BEGIN IF CHARSONLINE>0 THEN WRITELN(TTY,' ');
WRITE(TTY,'At most 256 VARCHAR specs are allowed');SHOWERRORCON;
END ELSE BEGIN CHECKTAG(C);CHARTAG[C]:=3;CHARREMAINDE[C]:=NE;
EXTEN[NE].B0:=0;EXTEN[NE].B1:=0;EXTEN[NE].B2:=0;EXTEN[NE].B3:=0;
WHILE LEVEL=2 DO BEGIN WHILE CURCHAR=32 DO GETNEXT;
IF CURCHAR=40 THEN{105:}BEGIN GETNAME;
IF CURCODE=0 THEN SKIPTOENDOFI ELSE IF(CURCODE<57)OR(CURCODE>60)THEN
BEGIN BEGIN IF CHARSONLINE>0 THEN WRITELN(TTY,' ');
WRITE(TTY,'This property name doesn''t belong in a VARCHAR list');
SHOWERRORCON;END;SKIPTOENDOFI;
END ELSE BEGIN CASE CURCODE-(57)OF 0:EXTEN[NE].B0:=GETBYTE;
1:EXTEN[NE].B1:=GETBYTE;2:EXTEN[NE].B2:=GETBYTE;3:EXTEN[NE].B3:=GETBYTE;
END;FINISHTHEPRO;END;END{:105}
ELSE IF CURCHAR=41 THEN SKIPTOENDOFI ELSE JUNKERROR;END;NE:=NE+1;
BEGIN LOC:=LOC-1;LEVEL:=LEVEL+1;CURCHAR:=41;END;END;END{:104};END;
FINISHTHEPRO;END;END{:103}
ELSE IF CURCHAR=41 THEN SKIPTOENDOFI ELSE JUNKERROR;END;
IF CHARWD[C]=0 THEN CHARWD[C]:=SORTIN(1,0);BEGIN LOC:=LOC-1;
LEVEL:=LEVEL+1;CURCHAR:=41;END;END{:102};END;PROCEDURE READINPUT;
BEGIN{82:}CURCHAR:=32;REPEAT WHILE CURCHAR=32 DO GETNEXT;
IF CURCHAR=40 THEN{84:}BEGIN GETNAME;
IF CURCODE=0 THEN SKIPTOENDOFI ELSE IF CURCODE>11 THEN BEGIN BEGIN IF
CHARSONLINE>0 THEN WRITELN(TTY,' ');
WRITE(TTY,'This property name doesn''t belong on the outer level');
SHOWERRORCON;END;SKIPTOENDOFI;END ELSE BEGIN{85:}
CASE CURCODE OF 1:READFOURBYTE(0);2:{88:}BEGIN NEXTD:=GETFIX;
IF(NEXTD<1048576)OR(NEXTD>=1073741824)THEN BEGIN IF CHARSONLINE>0 THEN
WRITELN(TTY,' ');
WRITE(TTY,'The design size must be between 1 and 1024');SHOWERRORCON;
END ELSE DESIGNSIZE:=NEXTD;END{:88};3:{89:}BEGIN NEXTD:=GETFIX;
IF NEXTD<=0 THEN BEGIN IF CHARSONLINE>0 THEN WRITELN(TTY,' ');
WRITE(TTY,'The number of units per design size must be positive');
SHOWERRORCON;END ELSE DESIGNUNITS:=NEXTD;END{:89};4:READBCPL(8,40);
5:READBCPL(48,20);6:HEADERBYTES[71]:=GETBYTE;7:{90:}
BEGIN WHILE CURCHAR=32 DO GETNEXT;
IF CURCHAR=84 THEN SEVENBITSAFE:=TRUE ELSE IF CURCHAR=70 THEN
SEVENBITSAFE:=FALSE ELSE BEGIN IF CHARSONLINE>0 THEN WRITELN(TTY,' ');
WRITE(TTY,'The flag value should be "TRUE" or "FALSE"');SHOWERRORCON;
END;REPEAT GETNEXT UNTIL(CURCHAR=40)OR(CURCHAR=41);END{:90};8:{91:}
BEGIN C:=GETBYTE;
IF C<18 THEN BEGIN BEGIN IF CHARSONLINE>0 THEN WRITELN(TTY,' ');
WRITE(TTY,'HEADER indices should be 18 or more');SHOWERRORCON;END;
REPEAT GETNEXT UNTIL(CURCHAR=40)OR(CURCHAR=41);
END ELSE IF 4*C+4>MAXHEADERBYT THEN BEGIN BEGIN IF CHARSONLINE>0 THEN
WRITELN(TTY,' ');
WRITE(TTY,'This HEADER index is too big for my present table size');
SHOWERRORCON;END;REPEAT GETNEXT UNTIL(CURCHAR=40)OR(CURCHAR=41);
END ELSE BEGIN WHILE HEADERPTR<4*C DO BEGIN HEADERBYTES[HEADERPTR]:=0;
HEADERPTR:=HEADERPTR+1;END;READFOURBYTE(4*C);HEADERPTR:=4*C+4;END;
END{:91};9:{92:}
BEGIN WHILE LEVEL=1 DO BEGIN WHILE CURCHAR=32 DO GETNEXT;
IF CURCHAR=40 THEN{93:}BEGIN GETNAME;
IF CURCODE=0 THEN SKIPTOENDOFI ELSE IF(CURCODE<20)OR(CURCODE>=51)THEN
BEGIN BEGIN IF CHARSONLINE>0 THEN WRITELN(TTY,' ');
WRITE(TTY,'This property name doesn''t belong in a TEXINFO list');
SHOWERRORCON;END;SKIPTOENDOFI;
END ELSE BEGIN IF CURCODE=20 THEN C:=GETBYTE ELSE C:=CURCODE-20;
IF C=0 THEN BEGIN BEGIN IF CHARSONLINE>0 THEN WRITELN(TTY,' ');
WRITE(TTY,'PARAMETER index must not be zero');SHOWERRORCON;END;
SKIPTOENDOFI;
END ELSE IF C>MAXPARAMWORD THEN BEGIN BEGIN IF CHARSONLINE>0 THEN
WRITELN(TTY,' ');
WRITE(TTY,'This PARAMETER index is too big for my present table size');
SHOWERRORCON;END;SKIPTOENDOFI;
END ELSE BEGIN WHILE NP<C DO BEGIN NP:=NP+1;PARAM[NP]:=0;END;
PARAM[C]:=GETFIX;FINISHTHEPRO;END;END;END{:93}
ELSE IF CURCHAR=41 THEN SKIPTOENDOFI ELSE JUNKERROR;END;
BEGIN LOC:=LOC-1;LEVEL:=LEVEL+1;CURCHAR:=41;END;END{:92};10:READLIGKERN;
11:READCHARINFO;END{:85};FINISHTHEPRO;END;END{:84}
ELSE IF(CURCHAR=41)AND NOT INPUTHASENDE THEN BEGIN BEGIN IF CHARSONLINE>
0 THEN WRITELN(TTY,' ');WRITE(TTY,'Extra right parenthesis');
SHOWERRORCON;END;LOC:=LOC+1;CURCHAR:=32;
END ELSE IF NOT INPUTHASENDE THEN JUNKERROR;UNTIL INPUTHASENDE{:82};END;
PROCEDURE CORRANDCHECK;VAR C:BYTE;LIGPTR:0..511;G:BYTE;BEGIN{109:}{110:}
IF UNUSEDLABEL THEN BEGIN FOR C:=0 TO 255 DO IF(CHARTAG[C]=1)AND(
CHARREMAINDE[C]=NL)THEN CHARTAG[C]:=0;
WRITELN(TTY,'Last LIGTABLE LABEL was not used.');END;
IF NL>0 THEN LIGKERN[NL-1].B0:=128{:110};SEVENUNSAFE:=FALSE;
FOR C:=0 TO 255 DO IF CHARWD[C]<>0 THEN{111:}CASE CHARTAG[C]OF 0:;
1:{113:}BEGIN IF CHARWD[C]=0 THEN BEGIN WRITE(TTY,
'There''s a LABEL but no CHARACTER spec for ');PRINTOCTAL(C);
WRITELN(TTY,'.');CHARWD[C]:=SORTIN(1,0);END;LIGPTR:=CHARREMAINDE[C];
REPEAT IF LIGKERN[LIGPTR].B2<128 THEN BEGIN BEGIN G:=LIGKERN[LIGPTR].B1;
IF(G>=128)AND(C<128)THEN SEVENUNSAFE:=TRUE;
IF CHARWD[G]=0 THEN BEGIN CHARWD[G]:=SORTIN(1,0);
WRITE(TTY,'LIG character generated by',' ');PRINTOCTAL(C);
WRITELN(TTY,' had no CHARACTER spec.');END;END;
BEGIN G:=LIGKERN[LIGPTR].B3;IF(G>=128)AND(C<128)THEN SEVENUNSAFE:=TRUE;
IF CHARWD[G]=0 THEN BEGIN CHARWD[G]:=SORTIN(1,0);
WRITE(TTY,'LIG character generated by',' ');PRINTOCTAL(C);
WRITELN(TTY,' had no CHARACTER spec.');END;END;
END ELSE BEGIN G:=LIGKERN[LIGPTR].B1;
IF(G>=128)AND(C<128)THEN SEVENUNSAFE:=TRUE;
IF CHARWD[G]=0 THEN BEGIN CHARWD[G]:=SORTIN(1,0);
WRITE(TTY,'KRN character generated by',' ');PRINTOCTAL(C);
WRITELN(TTY,' had no CHARACTER spec.');END;END;LIGPTR:=LIGPTR+1;
UNTIL LIGKERN[LIGPTR-1].B0=128;END{:113};2:BEGIN G:=CHARREMAINDE[C];
IF(G>=128)AND(C<128)THEN SEVENUNSAFE:=TRUE;
IF CHARWD[G]=0 THEN BEGIN CHARWD[G]:=SORTIN(1,0);
WRITE(TTY,'The character NEXTLARGER than',' ');PRINTOCTAL(C);
WRITELN(TTY,' had no CHARACTER spec.');END;END;3:{114:}
BEGIN IF EXTEN[CHARREMAINDE[C]].B0>0 THEN BEGIN G:=EXTEN[CHARREMAINDE[C]
].B0;IF(G>=128)AND(C<128)THEN SEVENUNSAFE:=TRUE;
IF CHARWD[G]=0 THEN BEGIN CHARWD[G]:=SORTIN(1,0);
WRITE(TTY,'TOP piece of character',' ');PRINTOCTAL(C);
WRITELN(TTY,' had no CHARACTER spec.');END;END;
IF EXTEN[CHARREMAINDE[C]].B1>0 THEN BEGIN G:=EXTEN[CHARREMAINDE[C]].B1;
IF(G>=128)AND(C<128)THEN SEVENUNSAFE:=TRUE;
IF CHARWD[G]=0 THEN BEGIN CHARWD[G]:=SORTIN(1,0);
WRITE(TTY,'MID piece of character',' ');PRINTOCTAL(C);
WRITELN(TTY,' had no CHARACTER spec.');END;END;
IF EXTEN[CHARREMAINDE[C]].B2>0 THEN BEGIN G:=EXTEN[CHARREMAINDE[C]].B2;
IF(G>=128)AND(C<128)THEN SEVENUNSAFE:=TRUE;
IF CHARWD[G]=0 THEN BEGIN CHARWD[G]:=SORTIN(1,0);
WRITE(TTY,'BOT piece of character',' ');PRINTOCTAL(C);
WRITELN(TTY,' had no CHARACTER spec.');END;END;
BEGIN G:=EXTEN[CHARREMAINDE[C]].B3;
IF(G>=128)AND(C<128)THEN SEVENUNSAFE:=TRUE;
IF CHARWD[G]=0 THEN BEGIN CHARWD[G]:=SORTIN(1,0);
WRITE(TTY,'REP piece of character',' ');PRINTOCTAL(C);
WRITELN(TTY,' had no CHARACTER spec.');END;END;END{:114};END{:111};
IF SEVENBITSAFE AND SEVENUNSAFE THEN WRITELN(TTY,
'The font is not really seven-bit-safe!');{115:}
IF NL>0 THEN FOR LIGPTR:=0 TO NL-1 DO IF LIGKERN[LIGPTR].B2<128 THEN
BEGIN C:=LIGKERN[LIGPTR].B3;
IF CHARWD[C]=0 THEN BEGIN LIGKERN[LIGPTR].B3:=0;
IF CHARWD[0]=0 THEN CHARWD[0]:=SORTIN(1,0);
WRITE(TTY,'Unused ','LIG step',' refers to nonexistent character ');
PRINTOCTAL(C);WRITELN(TTY,'!');END;END ELSE BEGIN C:=LIGKERN[LIGPTR].B1;
IF CHARWD[C]=0 THEN BEGIN LIGKERN[LIGPTR].B1:=0;
IF CHARWD[0]=0 THEN CHARWD[0]:=SORTIN(1,0);
WRITE(TTY,'Unused ','KRN step',' refers to nonexistent character ');
PRINTOCTAL(C);WRITELN(TTY,'!');END;END;
IF NE>0 THEN FOR G:=0 TO NE-1 DO BEGIN BEGIN C:=EXTEN[G].B0;
IF C>0 THEN IF CHARWD[C]=0 THEN BEGIN EXTEN[G].B0:=0;
IF CHARWD[0]=0 THEN CHARWD[0]:=SORTIN(1,0);
WRITE(TTY,'Unused ','VARCHAR TOP',' refers to nonexistent character ');
PRINTOCTAL(C);WRITELN(TTY,'!');END;END;BEGIN C:=EXTEN[G].B1;
IF C>0 THEN IF CHARWD[C]=0 THEN BEGIN EXTEN[G].B1:=0;
IF CHARWD[0]=0 THEN CHARWD[0]:=SORTIN(1,0);
WRITE(TTY,'Unused ','VARCHAR MID',' refers to nonexistent character ');
PRINTOCTAL(C);WRITELN(TTY,'!');END;END;BEGIN C:=EXTEN[G].B2;
IF C>0 THEN IF CHARWD[C]=0 THEN BEGIN EXTEN[G].B2:=0;
IF CHARWD[0]=0 THEN CHARWD[0]:=SORTIN(1,0);
WRITE(TTY,'Unused ','VARCHAR BOT',' refers to nonexistent character ');
PRINTOCTAL(C);WRITELN(TTY,'!');END;END;BEGIN C:=EXTEN[G].B3;
IF CHARWD[C]=0 THEN BEGIN EXTEN[G].B3:=0;
IF CHARWD[0]=0 THEN CHARWD[0]:=SORTIN(1,0);
WRITE(TTY,'Unused ','VARCHAR REP',' refers to nonexistent character ');
PRINTOCTAL(C);WRITELN(TTY,'!');END;END;END{:115};
FOR C:=0 TO 255 DO{116:}IF CHARTAG[C]=2 THEN BEGIN G:=CHARREMAINDE[C];
WHILE(G<C)AND(CHARTAG[G]=2)DO G:=CHARREMAINDE[G];
IF G=C THEN BEGIN CHARTAG[C]:=0;
WRITE(TTY,'A cycle of NEXTLARGER characters has been broken at ');
PRINTOCTAL(C);WRITELN(TTY,'.');END;END{:116};{118:}
DELTA:=SHORTEN(1,255);SETINDICES(1,DELTA);
IF DELTA>0 THEN WRITELN(TTY,'I had to round some ','width','s by',(((
DELTA+1)DIV 2)/1048576):1:7,' units.');DELTA:=SHORTEN(2,15);
SETINDICES(2,DELTA);
IF DELTA>0 THEN WRITELN(TTY,'I had to round some ','height','s by',(((
DELTA+1)DIV 2)/1048576):1:7,' units.');DELTA:=SHORTEN(3,15);
SETINDICES(3,DELTA);
IF DELTA>0 THEN WRITELN(TTY,'I had to round some ','depth','s by',(((
DELTA+1)DIV 2)/1048576):1:7,' units.');DELTA:=SHORTEN(4,63);
SETINDICES(4,DELTA);
IF DELTA>0 THEN WRITELN(TTY,'I had to round some ','italic correction',
's by',(((DELTA+1)DIV 2)/1048576):1:7,' units.');{:118}{:109}END;{:133}
{134:}BEGIN INITIALIZE;NAMEENTER;READINPUT;WRITELN(TTY,'.');
CORRANDCHECK;{120:}{122:}LH:=HEADERPTR DIV 4;NOTFOUND:=TRUE;BC:=0;
WHILE NOTFOUND DO IF(CHARWD[BC]>0)OR(BC=255)THEN NOTFOUND:=FALSE ELSE BC
:=BC+1;NOTFOUND:=TRUE;EC:=255;
WHILE NOTFOUND DO IF(CHARWD[EC]>0)OR(EC=0)THEN NOTFOUND:=FALSE ELSE EC:=
EC-1;IF BC>EC THEN BC:=1;MEMORY[1]:=MEMORY[1]+1;MEMORY[2]:=MEMORY[2]+1;
MEMORY[3]:=MEMORY[3]+1;MEMORY[4]:=MEMORY[4]+1;
LF:=6+LH+(EC-BC+1)+MEMORY[1]+MEMORY[2]+MEMORY[3]+MEMORY[4]+NL+NK+NE+NP;
{:122};{123:}WRITE(TFMFILE,(LF)DIV 256);WRITE(TFMFILE,(LF)MOD 256);
WRITE(TFMFILE,(LH)DIV 256);WRITE(TFMFILE,(LH)MOD 256);
WRITE(TFMFILE,(BC)DIV 256);WRITE(TFMFILE,(BC)MOD 256);
WRITE(TFMFILE,(EC)DIV 256);WRITE(TFMFILE,(EC)MOD 256);
WRITE(TFMFILE,(MEMORY[1])DIV 256);WRITE(TFMFILE,(MEMORY[1])MOD 256);
WRITE(TFMFILE,(MEMORY[2])DIV 256);WRITE(TFMFILE,(MEMORY[2])MOD 256);
WRITE(TFMFILE,(MEMORY[3])DIV 256);WRITE(TFMFILE,(MEMORY[3])MOD 256);
WRITE(TFMFILE,(MEMORY[4])DIV 256);WRITE(TFMFILE,(MEMORY[4])MOD 256);
WRITE(TFMFILE,(NL)DIV 256);WRITE(TFMFILE,(NL)MOD 256);
WRITE(TFMFILE,(NK)DIV 256);WRITE(TFMFILE,(NK)MOD 256);
WRITE(TFMFILE,(NE)DIV 256);WRITE(TFMFILE,(NE)MOD 256);
WRITE(TFMFILE,(NP)DIV 256);WRITE(TFMFILE,(NP)MOD 256);{:123};{125:}
HEADERBYTES[4]:=DESIGNSIZE DIV 16777216;
HEADERBYTES[5]:=(DESIGNSIZE DIV 65536)MOD 256;
HEADERBYTES[6]:=(DESIGNSIZE DIV 256)MOD 256;
HEADERBYTES[7]:=DESIGNSIZE MOD 256;
IF NOT SEVENUNSAFE THEN HEADERBYTES[68]:=128;
FOR J:=0 TO HEADERPTR-1 DO WRITE(TFMFILE,HEADERBYTES[J]);{:125};{126:}
INDEX[0]:=0;FOR C:=BC TO EC DO BEGIN WRITE(TFMFILE,INDEX[CHARWD[C]]);
WRITE(TFMFILE,INDEX[CHARHT[C]]*16+INDEX[CHARDP[C]]);
WRITE(TFMFILE,INDEX[CHARIC[C]]*4+CHARTAG[C]);
WRITE(TFMFILE,CHARREMAINDE[C]);END{:126};{128:}
FOR Q:=1 TO 4 DO BEGIN WRITE(TFMFILE,0);WRITE(TFMFILE,0);
WRITE(TFMFILE,0);WRITE(TFMFILE,0);P:=LINK[Q];
WHILE P>0 DO BEGIN OUTSCALED(MEMORY[P]);P:=LINK[P];END;END;{:128};{129:}
IF NL>0 THEN FOR LIGPTR:=0 TO NL-1 DO BEGIN WRITE(TFMFILE,LIGKERN[LIGPTR
].B0);WRITE(TFMFILE,LIGKERN[LIGPTR].B1);
WRITE(TFMFILE,LIGKERN[LIGPTR].B2);WRITE(TFMFILE,LIGKERN[LIGPTR].B3);END;
IF NK>0 THEN FOR KRNPTR:=0 TO NK-1 DO OUTSCALED(KERN[KRNPTR]){:129};
{130:}IF NE>0 THEN FOR C:=0 TO NE-1 DO BEGIN WRITE(TFMFILE,EXTEN[C].B0);
WRITE(TFMFILE,EXTEN[C].B1);WRITE(TFMFILE,EXTEN[C].B2);
WRITE(TFMFILE,EXTEN[C].B3);END;{:130};{131:}
FOR PARPTR:=1 TO NP DO BEGIN IF PARPTR=1 THEN{132:}
BEGIN IF PARAM[1]<0 THEN BEGIN PARAM[1]:=PARAM[1]+1073741824;
WRITE(TFMFILE,(PARAM[1]DIV 16777216)+192);
END ELSE WRITE(TFMFILE,PARAM[1]DIV 16777216);
WRITE(TFMFILE,(PARAM[1]DIV 65536)MOD 256);
WRITE(TFMFILE,(PARAM[1]DIV 256)MOD 256);WRITE(TFMFILE,PARAM[1]MOD 256);
END{:132}ELSE OUTSCALED(PARAM[PARPTR]);END{:131}{:120};END.{:134}